CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/program/swagn_r.zip/OOP.SWG/0044_Clock on Menubar.pas

Pascal/Delphi Source File | 1994-08-26 | 13KB | 543 lines

unit clocks;
{$X+}  {allow discardable function results}

{ Clock-on-a-menubar OOP extension to Turbo Vision apps

  Copyright (c) 1990 by Danny Thorpe

  Alarms have not been implemented.
}

interface
uses dos, objects, drivers, views, menus, dialogs, app, msgbox;

const  cmClockChangeDisplay = 1001;
       cmClockSetAlarm = 1002;

       ClockNoSecs   = 0;
       ClockDispSecs = 1;
       Clock12hour   = 0;
       Clock24hour   = 1;

type

     ClockDataRec = record
       Format: word;
       Seconds: word;
       RefreshStr: String[2];
       end;


     PClockMenu = ^TClockMenu;
     TClockMenu = object(TMenuBar)
       ClockOptions: ClockDataRec;
       Refresh: byte;
       LastTime: DateTime;
       TimeStr: string[10];
       constructor Init(var Bounds: TRect; Amenu: PMenu);
       procedure Draw;   virtual;
       procedure Update; virtual;
       procedure SetRefresh(Secs: integer);        virtual;
       procedure SetRefreshStr( Secs: string);     virtual;
       procedure ClockChangeDisplay;               virtual;
       procedure HandleEvent( var Event: TEvent);  virtual;
       function  FormatTimeStr(h,m,s:word):string; virtual;
       end;




implementation


function LeadingZero(w : Word) : String;
var
  s : String;
begin
  Str(w:0,s);
  if Length(s) = 1 then
    s := '0' + s;
  LeadingZero := s;
end;



constructor TClockMenu.Init(var Bounds: TRect; AMenu: PMenu);
  var Temp: PMenuBar;
      ClockMenu: PMenu;
      R: TRect;
  begin
  ClockMenu:= NewMenu(NewSubMenu('~'#0'~Clock ', hcNoContext, NewMenu(
                NewItem('~C~hange display','',0,cmClockChangeDisplay, hcNoContext,
                NewItem('Set ~A~larm','', 0, cmClockSetAlarm, hcNoContext,
                nil))),
                AMenu^.Items));
                { ^^ tack passed menubar on end of new clock menu }
  ClockMenu^.Default:= AMenu^.Default;

  TMenuBar.Init(Bounds, ClockMenu);

  fillchar(LastTime,sizeof(LastTime),#$FF);   {fill with 65000's}
  TimeStr:='';
  ClockOptions.Format:= Clock24Hour;
  ClockOptions.Seconds:= ClockDispSecs;
  SetRefresh(1);
  end;



procedure TClockMenu.Draw;
  var P: PMenuItem;
  begin
  P:= FindItem(#0);
  if P <> nil then
    begin
    DisposeStr(P^.Name);
    P^.Name:= NewStr('~'#0'~'+TimeStr);
    end;
  TMenuBar.Draw;
  end;



procedure TClockMenu.Update;
  var h,m,s,hund: word;
  begin
    GetTime(h,m,s,hund);
    if abs(s-LastTime.sec) >= Refresh then
      begin
      with LastTime do
        begin
        Hour:=h;
        Min:=m;
        Sec:=s;
        end;
      TimeStr:= FormatTimeStr(h,m,s);
      DrawView;
      end;
  end;




procedure TClockMenu.SetRefresh(Secs: integer);
  begin
  if Secs > 59 then
    Secs := 59;
  if Secs < 0 then
    Secs := 0;
  Refresh:= Secs;
  Str(Refresh:2,ClockOptions.RefreshStr);
  end;



procedure TClockMenu.SetRefreshStr( Secs: string);
  var temp,code: integer;
  begin
  val(Secs, temp, code);
  if code = 0 then
    SetRefresh(temp);
  end;




procedure TClockMenu.ClockChangeDisplay;

  var
    D: PDialog;
    Control: PView;
    Command: word;
    temp,code: integer;
    R: TRect;
    ClockData : ClockDataRec;

  begin

  ClockData := ClockOptions;

  R.Assign(14,3,48,15);
  D:= new(PDialog, Init(R, 'Clock Display'));

  R.Assign(3,3,20,5);
  Control:= new(PRadioButtons, Init(R,
            NewSItem('~1~2 hour',
            NewSItem('~2~4 hour',
            nil))));
  D^.Insert(Control);

  R.Assign(3,2,20,3);
  Control:= new(Plabel, Init(R, '~F~ormat', Control));
  D^.Insert(Control);

  R.Assign(3,6,20,7);
  Control:= new(PCheckBoxes, Init(R,
            NewSItem('~S~econds',
            nil)));
  D^.Insert(Control);

  R.Assign(16,9,20,10);
  Control:= new(PInputLine, Init(R, 2));
  D^.Insert(Control);

  R.Assign(2,8,20,9);
  Control:= new(PLabel, Init(R, '~R~efresh Rate', Control));
  D^.Insert(Control);

  R.Assign(2,9,15,10);
  Control:= new(PLabel, Init(R, '0-59 seconds', PLabel(Control)^.Link));
  D^.Insert(Control);

  R.Assign(21,3,31,5);
  Control:= new(PButton, Init(R, '~O~k', cmOk, bfDefault));
  D^.Insert(Control);

  R.Assign(21,6,31,8);
  Control:= new(PButton, Init(R, '~C~ancel', cmCancel, bfNormal));
  D^.Insert(Control);


  D^.SelectNext(False);
  D^.SetData(ClockData);
  repeat
    Command:= Desktop^.ExecView(D);
    if Command = cmOK then
      begin
      D^.GetData(ClockData);
      val(ClockData.RefreshStr,temp,code);
      if (code <> 0) or ((temp<0) or (temp>59)) then
        MessageBox('Refresh rate must be between 0 and 59 seconds.',nil,
           mfOKButton+mfError);
      end;
  until (Command = cmCancel)
     or ((code=0) and ((temp>=0) and (temp<=59)));

  Dispose(D, Done);

  if Command = cmOk then
    begin
    ClockOptions:= ClockData;
    SetRefreshStr(ClockData.RefreshStr);
    end;

  { update display to reflect changes immediately }
  TimeStr:= FormatTimeStr(LastTime.hour, LastTime.min, LastTime.sec);
  DrawView;
  end;





procedure TClockMenu.HandleEvent( var Event: TEvent);
  begin
  TMenuBar.HandleEvent( Event);
  if Event.What = evCommand then
    begin
    case Event.Command of
      cmClockChangeDisplay: ClockChangeDisplay;
      cmClockSetAlarm: ;
      end;
    end;
  end;




function TClockMenu.FormatTimeStr(h,m,s: word): string;
  var st, tail: string;
  begin
  tail:='';
  if ClockOptions.Format = Clock24Hour then
    st:= LeadingZero(h)
  else
    begin
    if h >= 12 then
      begin
      tail:= 'pm';
      if h>12 then
        dec(h,12);
      end
    else
      tail:= 'am';
    if h=0 then h:=12;   {12 am}
    str(h:0,st);    { no leading space on hours }
    end;

  st:=st+':'+ LeadingZero(m);


  if ClockOptions.Seconds = ClockDispSecs then
    st:= st+':'+LeadingZero(s);

  FormatTimeStr:= st + tail;
  end;




end.

{ ----------------------------- DEMO  ---------------------- }

program TestPlatform;

uses Objects, Drivers, Views, Menus, App,
     Dos,     { for the paramcount and paramstr funcs}
     Clocks;  { for the clock on the menubar object, TClockMenu }

{ This generic test platform has been hooked up to the clock-on-the-menubar
  object / unit.  Search for *** to find hook-up points.

  Copyright (c) 1990 by Danny Thorpe
}


const  cmNewWin =   100;
       cmFileOpen = 101;

       WinCount : Integer = 0;
       MaxLines = 50;


type  PInterior = ^TInterior;
      TInterior = object(TScroller)
        constructor init(var Bounds: TRect; AHScrollbar, AVScrollbar: PScrollbar);
        procedure Draw;  virtual;
        end;


      PDemoWindow = ^TDemoWindow;
      TDemoWindow = object(TWindow)
        constructor Init(WindowNo: integer);
        end;


      TMyApp = object(TApplication)
        procedure InitStatusLine;  virtual;
        procedure InitMenuBar;  virtual;
        procedure NewWindow;
        procedure HandleEvent( var Event: TEvent); virtual;
        procedure Idle; virtual;
        end;


var MyApp: TMyApp;
    Lines: array [0..MaxLines-1] of PString;
    LineCount: Integer;


constructor TInterior.Init(var Bounds: TRect; AHScrollbar, AVScrollbar: PScrollbar);
  begin
  TScroller.Init(Bounds,AHScrollbar,AVScrollbar);
  Growmode := gfGrowHiX + gfGrowHiY;
  Options := Options or ofFramed;
  SetLimit(128,LineCount);
  end;


procedure TInterior.Draw;
  var color: byte;
      y,i: integer;
      B: TDrawBuffer;

  begin
  TScroller.Draw;
  Color := GetColor($01);
  for y:= 0 to Size.Y -1 do
    begin
    MoveChar(B,' ',Color,Size.X);
    I := Delta.Y + Y;
    if (I<Linecount) and (Lines[I] <> nil) then
      MoveStr(B,Copy(Lines[I]^,Delta.X+1,size.x),Color);
    WriteLine(0,y,size.x,1,B);
    end;
  end;


procedure ReadFile;
  var  F: text;
       S: string;

  begin
  LineCount:=0;
  if paramcount = 0 then
    assign(F,'clockwrk.pas')
  else
    assign(F,paramstr(1));
  reset(F);
  while not eof(F) and (linecount < maxlines) do
    begin
    readln(f,s);
    Lines[Linecount] := NewStr(S);
    Inc(LineCount);
    end;
  Close(F);
  end;





constructor TDemoWindow.Init(WindowNo: Integer);
  var  LInterior, RInterior: PInterior;
       HScrollbar, VScrollbar: PScrollbar;
       R: TRect;
       Center: integer;

  begin
    R.Assign(0,0,40,15);
    R.Move(Random(40),Random(8));

    TWindow.Init(R, 'Window', wnNoNumber);
    GetExtent(R);
    Center:= (R.B.X + R.A.X) div 2;
    R.Assign(Center,R.A.Y+1,Center+1,R.B.Y-1);
    VScrollbar:= new(PScrollbar, Init(R));
    with VScrollbar^ do Options := Options or ofPostProcess;
    Insert(VScrollbar);
    GetExtent(R);
    R.Assign(R.A.X+2,R.B.Y-1,Center-1,R.B.Y);
    HScrollbar:= new(PScrollbar, Init(R));
    with HScrollbar^ do Options := Options or ofPostProcess;
    Insert(HScrollbar);
    GetExtent(R);
    R.Assign(R.A.X+1,R.A.Y+1,Center,R.B.Y-1);
    LInterior:= new(PInterior, Init(R, HScrollbar, VScrollbar));
    with LInterior^ do
      begin
      Options:= Options or ofFramed;
      Growmode:= GrowMode or gfGrowHiX;
      SetLimit(128,LineCount);
      end;
    Insert(LInterior);

    GetExtent(R);
    R.Assign(R.B.X-1,R.A.Y+1,R.B.X,R.B.Y-1);
    VScrollbar:= new(PScrollbar, Init(R));
    with VScrollbar^ do Options := Options or ofPostProcess;
    Insert(VScrollbar);
    GetExtent(R);
    R.Assign(Center+2,R.B.Y-1,R.B.X-2,R.B.Y);
    HScrollbar:= new(PScrollbar, Init(R));
    with HScrollbar^ do
      begin
      Options := Options or ofPostProcess;
      GrowMode:= GrowMode or gfGrowLoX;
      end;
    Insert(HScrollbar);
    GetExtent(R);
    R.Assign(Center+1,R.A.Y+1,R.B.X-1,R.B.Y-1);
    RInterior:= new(PInterior, Init(R, HScrollbar, VScrollbar));
    with RInterior^ do
      begin
      Options:= Options or ofFramed;
      Growmode:= GrowMode or gfGrowLoX;
      SetLimit(128,LineCount);
      end;
    Insert(RInterior);
    end;




procedure TMyApp.InitStatusLine;
  var R: TRect;

  begin
  GetExtent(R);      { find out how big the current view is }
  R.A.Y := R.B.Y-1;  { squeeze R down to one line at bottom of frame }
  StatusLine := New(PStatusline, Init(R,
                  NewStatusDef(0, $FFFF,
                    NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
                    NewStatusKey('~F4~ New', kbF4, cmNewWin,
                    NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
                    nil))),
                  nil)
                ));
  end;


{ *** The vvv below indicate the primary hook-up point for the menubar-clock.
  This programmer-defined normal menu structure will be tacked onto the
  end of the clock menubar in TClockMenu.Init.
}

procedure TMyApp.InitMenuBar;
  var R: TRect;

  begin
  GetExtent(R);       {***}
  r.b.y:= r.a.y+1;   { vvv }
  Menubar := New(PClockMenu, Init(R, NewMenu(
               NewSubMenu('~F~ile', hcNoContext, NewMenu(
                 NewItem('~O~pen','F3', kbF3, cmFileOpen, hcNoContext,
                 NewItem('~N~ew','F4', kbF4, cmNewWin, hcNoContext,
                 NewLine(
                 NewItem('E~x~it','Alt-X', kbAltX, cmQuit, hcNoContext,
                 nil))))),
               NewSubMenu('~W~indow', hcNoContext, NewMenu(
                 NewItem('~N~ext','F6', kbF6, cmNext, hcNoContext,
                 NewItem('~Z~oom','F7', kbF7, cmZoom, hcNoContext,
                 nil))),
               nil))    { one ) for each menu defined }
             )));
  end;


procedure TMyApp.NewWindow;
  var
    Window: PDemoWindow;
    R: TRect;

  begin
  inc(WinCount);
  Window:= New(PDemoWindow, Init(WinCount));
  Desktop^.Insert(Window);
  end;




{*** clock hook-up point - typecasting required to access "new" method }

procedure TMyApp.Idle;
  begin
  TApplication.Idle;
  PClockMenu(MenuBar)^.Update;
  end;




procedure TMyApp.HandleEvent( var Event: TEvent);
  begin
  TApplication.HandleEvent(Event);
  if Event.What = evCommand then
    begin
      case Event.Command of
        cmNewWin: NewWindow;
      else  { case }
        Exit;
      end;  { case }
      ClearEvent(Event);
    end; {if}
  end;








begin

readfile;

MyApp.Init;
MyApp.run;
MyApp.done;
end.